home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / XLISP 2.0 / XLISP Tools / Utility (UL) / VALUES.LSP < prev   
Encoding:
Lisp/Scheme  |  1988-04-07  |  1.4 KB  |  41 lines  |  [TEXT/ttxt]
  1. ;; Larry Mulcahy 1988
  2. ;; multiple values
  3.  
  4. (provide 'values)
  5. (require 'iteration "iter.lsp")
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ; values
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (defun values (&rest v) v)
  12.  
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; multiple-value-setq 
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16.  
  17. (defmacro multiple-value-setq (variables form)
  18.   (let* ((values-label (gensym))
  19.      (values-making-expression `(,values-label ,form))
  20.      (list-of-setqs 
  21.       (mapcar #'(lambda (n) `(setq ,(nth n variables)
  22.                        (nth ,n ,values-label)))
  23.           (iota (length variables)))))
  24.     `(let (,values-making-expression)
  25.        ,@list-of-setqs)))
  26.  
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28. ; multiple-value-bind
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30.  
  31. (defmacro multiple-value-bind (variables value-form &rest forms)
  32.   (let* ((values-label (gensym))
  33.          (values-making-expression `(,values-label ,value-form))
  34.          (list-of-variable-value-pairs
  35.            (mapcar #'(lambda (n) `(,(nth n variables)
  36.                                     (nth ,n ,values-label)))
  37.                    (iota (length variables)))))
  38.     `(let (,values-making-expression)
  39.        (let (,@list-of-variable-value-pairs)
  40.         ,@forms))))
  41.